www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\inc\Collection-b\Admin_ItemModify4.asp
<%@language=vbscript codepage=936 %> <% response.buffer=true %> <!--#include file="inc/conn.asp"--> <!--#include file="inc/function.asp"--> <!--#include file="Admin_ChkPurview.asp"--> <!--#include file="inc/ubbcode.asp"--> <% Dim RsItem,SqlItem,FoundErr,ErrMsg,Action,ItemID Dim LoginType,LoginUrl,LoginPostUrl,LoginUser,LoginPass,LoginFalse,LoginResult,LoginData Dim ListStr,LsString,LoString,ListPaingType,LPsString,LPoString,ListPaingStr1,ListPaingStr2,ListPaingID1,ListPaingID2,ListPaingStr3,HsString,HoString,HttpUrlType,HttpUrlStr Dim TsString,ToString,CsString,CoString,DateType,DsString,DoString,AuthorType,AsString,AoString,AuthorStr,CopyFromType,FsString,FoString,CopyFromStr,KeyType,KsString,KoString,KeyStr,NewsPaingType,NPsString,NPoString,NewsPaingStr,NewsPaingHtml Dim ListUrl,ListCode,NewsArrayCode,NewsArray,UrlTest,NewsCode Dim Testi Action=Trim(Request("Action")) ItemID=Trim(Request("ItemID")) FoundErr=False If ItemID="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>参数错误,项目ID不能为空</li>" Else ItemID=Clng(ItemID) End If If Action="SaveEdit" And FoundErr<>True Then Call SaveEdit() End If If FoundErr<>True Then Call GetTest() End If If FoundErr=True Then Call WriteErrMsg(ErrMsg) Else Call Main() End If '关闭数据库链接 Call CloseConn() Call CloseConnItem() %> <%Sub Main()%> <html> <head> <title>采集系统</title> <meta http-equiv="Content-Type" content="text/html; charset=gb2312"> <link rel="stylesheet" type="text/css" href="Admin_Style.css"> </head> <body leftmargin="0" topmargin="0" marginwidth="0" marginheight="0"> <table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border"> <tr> <td height="22" colspan="2" align="center" class="topbg"><strong>采 集 系 统 模 板 管 理</td> </tr> <tr class="tdbg"> <td width="65" height="30"><strong>管理导航:</strong></td> <td height="30">项目编辑 >> <a href="Admin_ItemModify.asp?ItemID=<%=ItemID%>">基本设置</a> >> <a href="Admin_ItemModify2.asp?ItemID=<%=ItemID%>">列表设置</a> >> <a href="Admin_ItemModify3.asp?ItemID=<%=ItemID%>">链接设置</a> >> <a href="Admin_ItemModify4.asp?ItemID=<%=ItemID%>"><font color=red>正文设置</font></a> >> <a href="Admin_ItemModify5.asp?ItemID=<%=ItemID%>">采样测试</a> >> <a href="Admin_ItemAttribute.asp?ItemID=<%=ItemID%>">属性设置</a> >> 完成</td> </tr> </table> <br> <table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" > <tr> <td height="22" colspan="2" class="title"> <div align="center"><strong>编 辑 项 目--列 表 新 闻 链 接 测 试</strong></div></td> </tr> </table> <table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" > <tr> <td height="22" colspan="2" class="tdbg">以下是分析后所得到的新闻绝对链接地址,请查看是否正确。<br> <% For Testi=0 To Ubound(NewsArray) Response.Write "<a href='" & NewsArray(Testi) & "' target=_blank>" & NewsArray(Testi) & "</a><br>" Next %> <br> 下一步将抽取第一条新闻进行测试,在填写以下标记时尽量不要使用第一条新闻。 </td> </tr> </table> <form method="post" action="Admin_ItemModify5.asp" name="form1"> <table width="100%" border="0" align="center" cellpadding="0" cellspacing="1" class="border" > <tr> <td height="22" colspan="2" class="title"> <div align="center"><strong>编 辑 项 目--正 文 设 置</strong></div> </td> </tr> <tr class="tdbg"> <td width="20%" class="tdbg" ><strong>标题开始标记:</strong><p> </p><p> </p> <strong>标题结束标记:</strong></td> <td class="tdbg" width="75%"> <textarea name="TsString" cols="49" rows="7"><%=TsString%></textarea><br> <textarea name="ToString" cols="49" rows="7"><%=ToString%></textarea></td> </tr> <tr class="tdbg"> <td width="20%" class="tdbg" ><strong>正文开始标记:</strong><p> </p><p> </p> <strong>正文结束标记:</strong></td> <td class="tdbg" width="75%"> <textarea name="CsString" cols="49" rows="7"><%=CsString%></textarea><br> <textarea name="CoString" cols="49" rows="7"><%=CoString%></textarea></td> </tr> <tr class="tdbg"> <td width="20%" class="tdbg" ><b>时<span lang="en-us"> </span>间<span lang="en-us"> </span>设<span lang="en-us"> </span>置:</b></td> <td class="tdbg" width="75%"> <input type="radio" value="0" name="DateType" <%If DateType=0 Then Response.Write "checked"%> onClick="Date1.style.display='none'">不作设置 <input type="radio" value="1" name="DateType" <%If DateType=1 Then Response.Write "checked"%> onClick="Date1.style.display=''">设置标签 </tr> <tr class="tdbg" id="Date1" style="display:'<%If DateType<>1 Then Response.Write "none"%>'"> <td width="20%" class="tdbg" ><strong><font color=blue>时间开始标记:</font></strong><p> </p> <p> </p> <strong><font color=blue>时间结束标记:</font></strong></td> <td class="tdbg" width="75%"> <textarea name="DsString" cols="49" rows="7"><%=DsString%></textarea><br> <textarea name="DoString" cols="49" rows="7"><%=DoString%></textarea></td> </tr> <tr class="tdbg"> <td width="20%" class="tdbg" ><b>作<span lang="en-us"> </span>者<span lang="en-us"> </span>设<span lang="en-us"> </span>置:</b></td> <td class="tdbg" width="75%"> <input type="radio" value="0" name="AuthorType" <%If AuthorType=0 Then Response.Write "checked"%> onClick="Author1.style.display='none';Author2.style.display='none'">不作设置 <input type="radio" value="1" name="AuthorType" <%If AuthorType=1 Then Response.Write "checked"%> onClick="Author1.style.display='';Author2.style.display='none'">设置标签 <input type="radio" value="2" name="AuthorType" <%If AuthorType=2 Then Response.Write "checked"%> onClick="Author1.style.display='none';Author2.style.display=''">指定作者</td> </tr> <tr class="tdbg" id="Author1" style="display:'<%If AuthorType<>1 Then Response.Write "none"%>'"> <td width="20%" class="tdbg" ><strong><font color=blue>作者开始标记:</font></strong><p> </p> <p> </p> <strong><font color=blue>作者结束标记:</font></strong></td> <td class="tdbg" width="75%"> <textarea name="AsString" cols="49" rows="7"><%=AsString%></textarea><br> <textarea name="AoString" cols="49" rows="7"><%=AoString%></textarea></td> </tr> <tr class="tdbg" id="Author2" style="display:'<%If AuthorType<>2 Then Response.Write "none"%>'"> <td width="20%" class="tdbg" ><strong><font color=blue>请指定作者:</font></strong></td> <td class="tdbg" width="75%"> <input name="AuthorStr" type="text" id="AuthorStr" value="<%=AuthorStr%>"> </td> </tr> <tr class="tdbg"> <td width="20%" class="tdbg" ><b>来 源 设 置:</b></td> <td class="tdbg" width="75%"> <input type="radio" value="0" name="CopyFromType" <%If CopyFromType=0 Then Response.Write "checked"%> onClick="CopyFrom1.style.display='none';CopyFrom2.style.display='none'">不作设置 <input type="radio" value="1" name="CopyFromType" <%If CopyFromType=1 Then Response.Write "checked"%> onClick="CopyFrom1.style.display='';CopyFrom2.style.display='none'">设置标签 <input type="radio" value="2" name="CopyFromType" <%If CopyFromType=2 Then Response.Write "checked"%> onClick="CopyFrom1.style.display='none';CopyFrom2.style.display=''">指定来源</td> </tr> <tr class="tdbg" id="CopyFrom1" style="display:'<%If CopyFromType<>1 Then Response.Write "none"%>'"> <td width="20%" class="tdbg" ><strong><font color=blue>来源开始标记:</font></strong><p> </p> <p> </p> <strong><font color=blue>来源结束标记:</font></strong></td> <td class="tdbg" width="75%"> <textarea name="FsString" cols="49" rows="7"><%=FsString%></textarea><br> <textarea name="FoString" cols="49" rows="7"><%=FoString%></textarea></td> </tr> <tr class="tdbg" id="CopyFrom2" style="display:'<%If CopyFromType<>2 Then Response.Write "none"%>'"> <td width="20%" class="tdbg" ><strong><font color=blue>请指定来源:</font></strong></td> <td class="tdbg" width="75%"> <input name="CopyFromStr" type="text" id="CopyFromStr" value="<%=CopyFromStr%>"> </td> </tr> <tr class="tdbg"> <td width="20%" class="tdbg" ><b>关键字词设置:</b></td> <td class="tdbg" width="75%"> <input type="radio" value="0" name="KeyType" <%If KeyType=0 Then Response.Write "checked"%> onClick="Key1.style.display='none';Key2.style.display='none'">标题生成 <input type="radio" value="1" name="KeyType" <%If KeyType=1 Then Response.Write "checked"%> onClick="Key1.style.display='';Key2.style.display='none'">标签生成 <input type="radio" value="2" name="KeyType" <%If KeyType=2 Then Response.Write "checked"%> onClick="Key1.style.display='none';Key2.style.display=''">自定义关键字</td> </tr> <tr class="tdbg" id="Key1" style="display:'<%If KeyType<>1 Then Response.Write "none"%>'"> <td width="20%" class="tdbg" ><strong><font color=blue>关键词开始标记:</font></strong><p> </p> <p> </p> <strong><font color=blue>关键词结束标记:</font></strong></td> <td class="tdbg" width="75%"> <textarea name="KsString" cols="49" rows="7"><%=KsString%></textarea><br> <textarea name="KoString" cols="49" rows="7"><%=KoString%></textarea></td> </tr> <tr class="tdbg" id="Key2" style="display:'<%If KeyType<>2 Then Response.Write "none"%>'"> <td width="20%" class="tdbg" ><strong><font color=blue>请指定关键:</font></strong></td> <td class="tdbg" width="75%"> <input name="KeyStr" type="text" id="KeyStr" value="<%=KeyStr%>"> </td> </tr> <tr> <td width="20%" class="tdbg"><strong>正文分页设置:</strong></td> <td class="tdbg" width="75%"> <input type="radio" value="0" name="NewsPaingType" <%If NewsPaingType=0 Then Response.Write "checked"%> onClick="NewsPaing1.style.display='none';NewsPaing12.style.display='none';NewsPaing13.style.display='none';NewsPaing2.style.display='none'">不作设置 <input type="radio" value="1" name="NewsPaingType" <%If NewsPaingType=1 Then Response.Write "checked"%> onClick="NewsPaing1.style.display='';NewsPaing12.style.display='';NewsPaing13.style.display='';NewsPaing2.style.display='none'">设置标签 <input type="radio" value="2" name="NewsPaingType" <%If NewsPaingType=2 Then Response.Write "checked"%> onClick="NewsPaing1.style.display='none';NewsPaing12.style.display='none';NewsPaing13.style.display='none';NewsPaing2.style.display=''">手动设置 </td> </tr> <tr class="tdbg" id="NewsPaing1" style="display:'<%If NewsPaingType<>1 Then Response.Write "none"%>'"> <td width="20%" class="tdbg"><strong><font color=blue>下页开始标记:</font></strong><p> </p><p> </p> <strong><font color=blue>下页结束标记:</font></strong></td> <td class="tdbg" width="75%"> <textarea name="NPsString" cols="49" rows="7"><%=NPsString%></textarea><br> <textarea name="NPoString" cols="49" rows="7"><%=NPoString%></textarea></td> </tr> <tr class="tdbg" class="tdbg" id="NewsPaing12" style="display:'<%If NewsPaingType<>1 Then Response.Write "none"%>'"> <td width="20%" class="tdbg"><b><font color="#0000FF">分页绝对链接:</font></b></td> <td class="tdbg" width="75%"> <input name="NewsPaingStr" type="text" size="58" value="<%=NewsPaingStr%>"></td> </tr> <tr class="tdbg" class="tdbg" id="NewsPaing13" style="display:'<%If NewsPaingType<>1 Then Response.Write "none"%>'"> <td width="20%" class="tdbg"><b><font color="#0000FF">分页链接字符:</font></b></td> <td class="tdbg" width="75%"> <input name="NewsPaingHtml" type="text" size="58" value="<%=NewsPaingHtml%>"></td> </tr> <tr class="tdbg" class="tdbg" id="NewsPaing2" style="display:'<%If NewsPaingType<>2 Then Response.Write "none"%>'"> <td width="20%" class="tdbg"><strong><font color=blue>手 动 设 置:</font></strong></td> <td class="tdbg" width="75%"> <input name="NewsPaingStr2" type="text" value="预留功能" size="58"> </td> </tr> <tr class="tdbg"> <td colspan="2" align="center" class="tdbg"><br> <input name="ChannelID" type="hidden" id="ChannelID" value="<%=Request.Form("ChannelID")%>"> <input name="ClassID" type="hidden" id="ClassID" value="<%=Request.Form("ClassID")%>"> <input name="SpecialID" type="hidden" id="SpecialID" value="<%=Request.Form("SpecialID")%>"> <input name="Action" type="hidden" id="Action" value="SaveEdit"> <input name="ItemID" type="hidden" id="ItemID" value="<%=ItemID%>"> <input type="button" name="button1" value="上 一 步" onClick="window.location.href='javascript:history.go(-1)'" style="cursor: hand;background-color: #cccccc;"> <input type="submit" name="Submit" value="下 一 步" style="cursor: hand;background-color: #cccccc;"></td> <input type="hidden" name="UrlTest" id="UrlTest" value="<%=UrlTest%>"> </tr> </table> </form> <!--#include file="Admin_ItemFoot.asp"--> </body> </html> <%End Sub%> <% Sub SaveEdit HsString=Request.Form("HsString") HoString=Request.Form("HoString") HttpUrlType=Trim(Request.Form("HttpUrlType")) HttpUrlStr=Trim(Request.Form("HttpUrlStr")) If HsString="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>链接开始标记不能为空</li>" End If If HoString="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>链接结束标记不能为空</li>" End If If HttpUrlType="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>请选择链接处理类型</li>" Else HttpUrlType=Clng(HttpUrlType) If HttpUrlType=1 Then If HttpUrlStr="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>请设置绝对链接地址</li>" Else If Len(HttpUrlStr)<15 Then FoundErr=True ErrMsg=ErrMsg & "<br><li>绝对链接地址设置不正确(至少15个字符)</li>" End If End If End If End If If FoundErr<>True Then SqlItem="Select ItemID,HsString,HoString,HttpUrlType,HttpUrlStr from Item Where ItemID=" & ItemID Set RsItem=server.CreateObject("adodb.recordset") RsItem.Open SqlItem,ConnItem,2,3 RsItem("HsString")=HsString RsItem("HoString")=HoString RsItem("HttpUrlType")=HttpUrlType If HttpUrlType=1 Then RsItem("HttpUrlStr")=HttpUrlStr End If RsItem.UpDate RsItem.Close Set RsItem=Nothing End If End Sub Sub GetTest SqlItem="Select * from Item Where ItemID=" & ItemID Set RsItem=server.CreateObject("adodb.recordset") RsItem.Open SqlItem,ConnItem,1,1 If RsItem.Eof And RsItem.Bof Then FoundErr=True ErrMsg=ErrMsg & "<br><li>参数错误,项目ID不能为空</li>" Else LoginType=RsItem("LoginType") LoginUrl=RsItem("LoginUrl") LoginPostUrl=RsItem("LoginPostUrl") LoginUser=RsItem("LoginUser") LoginPass=RsItem("LoginPass") LoginFalse=RsItem("LoginFalse") ListStr=RsItem("ListStr") LsString=RsItem("LsString") LoString=RsItem("LoString") ListPaingType=RsItem("ListPaingType") LPsString=RsItem("LPsString") LPoString=RsItem("LPoString") ListPaingStr1=RsItem("ListPaingStr1") ListPaingStr2=RsItem("ListPaingStr2") ListPaingID1=RsItem("ListPaingID1") ListPaingID2=RsItem("ListPaingID2") ListPaingStr3=RsItem("ListPaingStr3") HsString=RsItem("HsString") HoString=RsItem("HoString") HttpUrlType=RsItem("HttpUrlType") HttpUrlStr=RsItem("HttpUrlStr") TsString=RsItem("TsString") ToString=RsItem("ToString") CsString=RsItem("CsString") CoString=RsItem("CoString") DateType=RsItem("DateType") DsString=RsItem("DsString") DoString=RsItem("DoString") AuthorType=RsItem("AuthorType") AsString=RsItem("AsString") AoString=RsItem("AoString") AuthorStr=RsItem("AuthorStr") CopyFromType=RsItem("CopyFromType") FsString=RsItem("FsString") FoString=RsItem("FoString") CopyFromStr=RsItem("CopyFromStr") KeyType=RsItem("KeyType") KsString=RsItem("KsString") KoString=RsItem("KoString") KeyStr=RsItem("KeyStr") NewsPaingType=RsItem("NewsPaingType") NPsString=RsItem("NPsString") NPoString=RsItem("NPoString") NewsPaingStr=RsItem("NewsPaingStr") NewsPaingHtml=RsItem("NewsPaingHtml") End If RsItem.Close Set RsItem=Nothing If LsString="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>列表开始标记不能为空!</li>" End If If LoString="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>列表结束标记不能为空!</li>" End If If ListPaingType=0 Or ListPaingType=1 Then If ListStr="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>列表索引页不能为空!</li>" End If If ListPaingType=1 Then If LPsString="" Or LPoString="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>索引分页开始、结束标记不能为空!</li>" End If End If If ListPaingStr1<>"" And Len(ListPaingStr1)<15 Then FoundErr=True ErrMsg=ErrMsg & "<br><li>索引分页重定向设置不正确!</li>" End IF ElseIf ListPaingType=2 Then If ListPaingStr2="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>批量生成原字符串不能为空!</li>" End If If IsNumeric(ListPaingID1)=False or IsNumeric(ListPaingID2)=False Then FoundErr=True ErrMsg=ErrMsg & "<br><li>批量生成的范围只能是数字!</li>" Else ListPaingID1=Clng(ListPaingID1) ListPaingID2=Clng(ListPaingID2) If ListPaingID1=0 And ListPaingID2=0 Then FoundErr=True ErrMsg=ErrMsg & "<br><li>批量生成的范围不正确!</li>" End If End If ElseIf ListPaingType=3 Then If ListPaingStr3="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>索引分页不能为空!</li>" End If Else FoundErr=True ErrMsg=ErrMsg & "<br><li>请选择返回上一步设置索引分页类型</li>" End If If LoginType=1 Then If LoginUrl="" or LoginPostUrl="" or LoginUser="" Or LoginPass="" Or LoginFalse="" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>请将登录信息填写完整</li>" End If End If If FoundErr<>True Then Select Case ListPaingType Case 0,1 ListUrl=ListStr Case 2 ListUrl=Replace(ListPaingStr2,"{$ID}",CStr(ListPaingID1)) Case 3 If Instr(ListPaingStr3,"|")> 0 Then ListUrl=Left(ListPaingStr3,Instr(ListPaingStr3,"|")-1) Else ListUrl=ListPaingStr3 End If End Select End If If FoundErr<>True And Action<>"SaveEdit" And LoginType=1 Then LoginData=UrlEncoding(LoginUser & "&" & LoginPass) LoginResult=PostHttpPage(LoginUrl,LoginPostUrl,LoginData) If Instr(LoginResult,LoginFalse)>0 Then FoundErr=True ErrMsg=ErrMsg & "<br><li>登录网站时发生错误,请确认登录信息的正确性!</li>" End If End If If FoundErr<>True Then ListCode=GetHttpPage(ListUrl) If ListCode<>"$False$" Then ListCode=GetBody(ListCode,LsString,LoString,False,False) If ListCode="$False$" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>在截取列表时发生错误。</li>" End If Else FoundErr=True ErrMsg=ErrMsg & "<br><li>在获取:" & ListUrl & "网页源码时发生错误。</li>" End If End If If FoundErr<>True Then NewsArrayCode=GetArray(ListCode,HsString,HoString,False,False) If NewsArrayCode="$False$" Then FoundErr=True ErrMsg=ErrMsg & "<br><li>在分析:" & ListUrl & "新闻列表时发生错误!</li>" Else NewsArray=Split(NewsArrayCode,"$Array$") If IsArray(NewsArray)=True Then For Testi=0 To Ubound(NewsArray) If HttpUrlType=1 Then NewsArray(Testi)=Replace(HttpUrlStr,"{$ID}",NewsArray(Testi)) Else NewsArray(Testi)=DefiniteUrl(NewsArray(Testi),ListUrl) End If Next UrlTest=NewsArray(0) NewsCode=GetHttpPage(UrlTest) Else FoundErr=True ErrMsg=ErrMsg & "<br><li>在分析:" & ListUrl & "新闻列表时发生错误!</li>" End If End If End If End Sub %>